home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 32 / cadence.zip / VOL2NO4.ZIP / IOUTIL.LSP < prev    next >
Lisp/Scheme  |  1987-05-14  |  3KB  |  94 lines
  1.  
  2.  
  3. ; ===========================================================
  4. ;
  5. ;   AutoLISP Concepts                    April 1987
  6. ;   Bill Kramer
  7. ;
  8. ;   AutoLISP Programmer I/O Utilities
  9. ;
  10. ; ===========================================================
  11. ;
  12. ;   Listing 1.  Experiments with GRREAD.
  13. ;
  14. (defun c:Exper1 ()
  15.    (setq Exit nil)
  16.    (while (null Exit)
  17.       (print
  18.         (grread))))
  19. ;
  20. (defun c:Exper2 ()
  21.    (setq Exit nil Track 1)
  22.    (while (null Exit)
  23.       (print
  24.          (grread Track))))
  25. ;
  26. ;
  27. ;  Listing 2.  Utility for Menulist I/O.
  28. ;
  29. (defun Menu (Menu-list)
  30.    (while (< (length Menu-list) 20)
  31.       (setq Menu-list (append Menu-list (list ""))))
  32.    (setq NN 0)
  33.    (while (< NN 20)
  34.      (grtext NN (nth NN Menu-list))
  35.      (setq NN (1+ NN))) 
  36.    (setq NN nil)
  37.    (while (null NN)
  38.      (setq TT (grread))
  39.      (cond
  40.        ((and (= (car TT) 2) (= (cadr TT) 13))
  41.           (setq NN ""))
  42.        ((= (car TT) 4)
  43.           (setq NN
  44.              (nth
  45.                (cadr TT) Menu-list))))))
  46. ;
  47. ;  Listing 3. Generic Input of Standard Types with Default Values.
  48. ;
  49. (defun getinput (Prmpt Dflt)
  50.   (setq S
  51.     (cond
  52.       ((= (type Dflt) 'REAL)
  53.         (getreal (strcat Prmpt " <" (rtos Dflt) "> ")))
  54.       ((= (type Dflt) 'INT)
  55.         (getint (strcat Prmpt " <" (itoa Dflt) "> ")))
  56.       ((= (type Dflt) 'STR)
  57.         (getstring (strcat Prmpt " <" Dflt "> ")))))
  58.   (cond
  59.     ((or (null S) (= S "")) Dflt)
  60.     (t S)))
  61. ;
  62. ;  Listing 4. Read Only Workstation Control
  63. ;
  64. (defun C:ROWSC ()
  65.    (setvar "CMDECHO" 0)
  66.    (setq Finished nil)
  67.    (while (not Finished)
  68.       (prompt "\nCommand> ")
  69.       (setq Option (Menu '("  Read" "  Only" "   W/S" "--------" ""
  70.                            "Window" "" "See All" "" "Exit")))
  71.       (cond
  72.         ((= Option "Exit") (command "QUIT" "Y"))
  73.         ((= Option "See All") (prompt "See all") (command "ZOOM" "E"))
  74.         ((= Option "Window")
  75.             (setq P1 (getpoint "Show Window point 1: ")) 
  76.             (prompt "  Show other corner: ")
  77.             (setq Exit nil CON -1 Oldp P1)
  78.             (while (null Exit)
  79.                (setq P2 (grread 1))           
  80.                (cond
  81.                 ((and (= (car P2) 5) (> (distance Oldp (cadr P2)) 0.001)) 
  82.                     (grbox P1 oldp CON)
  83.                     (grbox P1 (setq P2 (cadr P2)) CON) 
  84.                     (setq Oldp P2))
  85.                 ((= (car P2) 3)
  86.                     (grbox P1 Oldp CON)
  87.                     (setq P2 (cadr P2)
  88.                           Exit 1))))
  89.             (command "ZOOM" "W" P1 P2))))) 
  90. (defun grbox (P1 P2 Color)
  91.    (grdraw P1 (list (car P1) (cadr P2)) Color)
  92.    (grdraw (list (car P2) (cadr P1)) P1 Color)
  93. )